perm filename MRK.F4[P11,LCS] blob
sn#589305 filedate 1981-05-23 generic text, type T, neo UTF8
C*** MRK, YPOS, R4SET, MRKZ, TENUTO, MRKX ***************
C****** MARKS ON NOTES **********
C 4=WDG, 5=ACCNT, 7 STACC, 9=TEN, 11=DNBOW, 12=UPBOW, 13=HARM, 14=+
C 15=THESIS, 16=ARSIS, 17=MORD, 18= INVMORD, 20=TR, 21=Tb, 22=T#, 23=TNAT
C 25=HVYWDG, 26=FERM, 27=TEN-STACC, 28=WDG-STACC, 29=ACCNT-STACC
C 30-35=FINGERING, 21-23=MUSICA FICTA
SUBROUTINE MRK
COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
COMMON/DAT/RACNT(69),RDOT(17),NXAC(7)
COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,
1 RRR(8),RLVL,JQ(20) /STF/RSTFAC(0/7),RSTJ2
COMMON /FONT/JFONT /PLTR/IPLT,RHT,DIS,XDIS /POSI/STFF(0/7),JJ2,POS
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
EQUIVALENCE (J5,JQ(3)),(J11,JQ(9)),(J9,JQ(7))
1,(J3,JQ(1)),(RX4,JQ(19)),(ISTEM,JQ(20)),(J7,JQ(5))
JSTEM=IABS(JSTEM)
MRK=J11/100
C GET MARK CLOSEST TO NOTE HEAD. (LEFT 2 DIGITS)
J5=J11-MRK*100
R11=10.*(R11-J11)
R13=R11
IF(R11.EQ.0)GO TO 100
IF(RSTJ2.NE.RMINI)R11=R11*RMINI/RSTJ2
C***** STEM DIRECTION?????******** (MATTERS FOR J11=4,5,7,9, OR -J11
C SHIFT AWAY FROM NORMAL VERTICAL POS. (.15 SHIFTS UP 1.5 STEPS)
100 RR4=R4
R4=RLVL
R3=RJAC
J4=R4
IF(J5.GT.9)GO TO 10
GO TO(1,1,1,4,5,26,7,5,9)J5
10 IF(J5.GT.19)GO TO 200
GO TO(11,11,11,11,11,11,17,17)J5-10
200 IF(J5.GT.29)GO TO 30
GO TO(20,20,20,20,5,25,26,27,28,29)J5-19
C**** FICTA
1 J5=J5+9
CALL SAVEM
R7=0
R6=.42
C R6 (SIZE) COULD BE CHANGED ****
IF(NTYPE.EQ.1)R6=.26
CALL R4SET(.8,5.8,10.5)
CC R3=R3+15.*RSTJ2
R3=R3+15.*RMINI
R8=0
J9=0
CALL CLEFS
C 29 STILL OPEN FOR MARKS IN SUBR. FERMTA
GO TO 31
C**** WEDGE
4 JX=5
RX=R3+.5*RSTJ2
C SHIFT A LITTLE TO RIGHT
41 CALL YPOS(14.,RY)
RA=RMINI
RB=RA
IF(JSTEM.EQ.1)RA=-RA
40 CALL MRKZ(JX,RY)
GO TO 300
C**** ACCENT
5 JX=1
RX=R3
GO TO 41
C**** STACCATO
7 RX=6.7
RX=R3+RX*RMINI
C PUSH DOT TO RIGHT
RG=9.
IF(IPLT.LT.0)RG=17.
C DOESN'T FILL DOT ON DPY
9 RB=14.
IF(JSTEM.EQ.1)GO TO 70
IF(J4.GT.9)GO TO 73
GO TO 71
70 IF(J4.LT.5)GO TO 73
71 IF(MOD(J4,2).NE.0)RB=21.
73 CALL YPOS(RB,RY)
IF(J5.EQ.9)GO TO 90
77 CALL RDRAW(1,RG,RDOT,RMINI,RX,RY+RSTJ2,RMINI)
GO TO 300
C**** TENUTO (DASH) (STARTS ABOVE)
90 CALL TENUTO(RY)
GO TO 300
C*** UPBOW, ETC.
11 RA=RMINI
RB=RA
RX=R3
CALL R4SET(3.,8.,12.5)
CALL CENTX
CALL MRKZ(NXAC(J5-10),CENTR)
GO TO 300
C*** 17=MORDENT 18=INVERTED MORDENT
17 RINV=J5
CALL R4SET(3.,8.,12.5)
GO TO 260
C*** TRILL
20 CALL R4SET(3.,8.,12.5)
CALL SAVEM
JA=7
R5=0
R7=1.
J7=1
R8=J5-20
C R8 HAS THE ACCIDENTAL TO PUT OVER TR.
CALL ALPHA
GO TO 31
C*** HEAVY WEDGE
25 CALL SAVEM
RINV=1.0
R7=0
RX4=RLVL
ISTEM=JSTEM
CALL FERMTA
GO TO 31
C*** FERMATA
26 CALL SAVEM
RINV=1.
CALL R4SET(2.,7.,11.75)
260 CALL CENTX
CALL FERMTA
GO TO 31
C*** TENUTO-STACC. (DOT CLOSEST TO NOTE HEAD)
27 MRK=-9
270 J5=0
GO TO 7
C*** WEDGE-STACC.
28 MRK=-4
GO TO 270
C*** ACCENT-STACC.
29 MRK=-5
GO TO 270
C*** FINGERING
30 R5=J5-30
C GET THE 1 DIGIT NUM.
C PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
CALL SAVEM
R6=.7
C SIZE OF NUM.
RX=6.
IF(JSTEM.EQ.1)RX=8.
C STEM UP, THEN SHIFT A LITTLE TO RIGHT
J3=R3+RX*RMINI
R7=0
R8=0
R9=0
RA=2.5
IF(JSTEM.EQ.1)RA=-4.
R4=R4+RA
C HGT OF NUM.
CALL MAKNUM(R5)
C ADD HERE FOR NUMS WITH ACCENTS, ETC.
31 CALL GETEM
300 IF(MRK.EQ.0)RETURN
IF(MRK.GT.0)GO TO 301
C WILL ONLY DO CERTAIN COMBINATIONS OF MARKS
C THIS FEATURE NEEDS MORE WORK
MRK=-MRK
C ACCENT,DASH,WEDGE OVER STACC.
IF(MRK.EQ.9)GO TO 304
C JUMP FOR TENUTO. NEXT FOR ACCENT OR WEDGE
IF(JSTEM.EQ.1)GO TO 305
J5=1
IF(J4.GT.9)GO TO 303
306 IF(MOD(J4,2).NE.0)J5=J5*2
GO TO 303
305 J5=-1
IF(J4.LT.5)GO TO 303
GO TO 306
304 IF(JSTEM.EQ.1)GO TO 302
J5=1
IF(J4.LT.9)J5=2
GO TO 303
C WHAT ABOUT IF NO LEDGER LINES?
302 J5=-1
IF(J4.GT.5)J5=-2
303 J4=J4+J5
R4=J4
CALL CENTX
301 J5=MRK
C GET 2ND MARK
MRK=0
GO TO 100
END
SUBROUTINE YPOS(R,RY)
COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM
COMMON R2,JA,CENTR,J2,RJQ(9),R12,R13 /STF/RSTFAC(0/7),RSTJ2
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI
RB=R+R13*7.
IF(JSTEM.EQ.1)RB=-RB
C 1=STEM UP, 2=STEM DOWN
RY=RSTJ2
IF(R12.NE.0)RY=RMINI
C FOR NEW GENERAL SIZE FACTOR
RY=CENTR+RB*RY
END
SUBROUTINE R4SET(R,S,T)
COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
COMMON R2,JA,CENTR,J2,RJQ(20)
EQUIVALENCE (R11,RJQ(9)),(R4,RJQ(2)),(R8,RJQ(6))
Q=R
IF(JSTEM.EQ.1)Q=S+R8
R4=R4+Q
IF(R4.LT.T)R4=T
R4=R4+R11
C R11=DISPLACEMENT ****** CHECK THIS
END
SUBROUTINE MRKZ(JX,Y)
COMMON/DAT/RACNT(69),RDOT(17),NXAC(7)
COMMON R2,JA,CNTR,J2,RJQ(20),J3,J4,J5 /PLTR/IPLT,RHT,DIS,XDIS
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,RB
JT=0
IF(IPLT.LT.0)JT=-2
C JT IS FOR THICKENING WHEN PLOTTING
JX1=JX+1
43 CALL RDRAW(JX1,RACNT(JX),RACNT,RA,RX,Y,RB)
IF(JT.EQ.0)RETURN
JT=JT+1
IF(J5.EQ.13)GO TO 42
Y=Y-XDIS
IF(J5.EQ.14)RX=RX-XDIS
C 14=PLUS
GO TO 43
42 RB=RB+.03
C INCREASE SIZE FOR THICKENING HARMONIC
GO TO 43
END
SUBROUTINE TENUTO(Y)
C**** TENUTO (DASH)
COMMON R2,JA,CNTR,J2,R3 /PLTR/IPLT,RHT,DIS,XDIS
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX
RX=R3+RMINI*14.
CALL LINX(R3,Y,RX,Y)
IF(IPLT.GE.0)RETURN
C MAKE THICKER IF PLOTTING
Y=Y-XDIS
CALL LINX(R3,Y,RX,Y)
END
C******CODE 9 MARKS **********
C 4=WDG, 5=ACCNT, 7 STACC, 9=TEN, 11=DNBOW, 12=UPBOW, 13=HARM, 14=+
C 15=THESIS, 16=ARSIS, 17=MORD, 18= INVMORD, 20=TR, 21=Tb, 22=T#, 23=TNAT
C 25=HVYWDG, 26=FERM, 27=TEN-STACC, 28=WDG-STACC, 29=ACCNT-STACC
C 30-35=FINGERING, 21-23=MUSICA FICTA
SUBROUTINE MRKX
COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
COMMON/DAT/RACNT(69),RDOT(17),NXAC(7)
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
COMMON /PLTR/IPLT,RHT,DIS,XDIS /POSI/STFF(0/7),JJ2,POS
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(R11,RJQ(9))
1,(R4,RJQ(2)),(RLVL,RJQ(20)),(R6,RJQ(4)),(J11,JQ(9)),(J9,JQ(7))
1,(R7,RJQ(5)),(R8,RJQ(6)),(R9,RJQ(7)),(J3,JQ(1)),(RX4,JQ(19))
1,(ISTEM,JQ(20)),(J7,JQ(5))
RMINI=RSTJ2
RINV=1.
IF(J5)2,21,101
C GO BACK IF NO NUM. IN J5
21 RETURN
2 J5=-J5
RINV=-RINV
101 CALL NOZERO(R6)
RMINI=RMINI*R6
JSTEM=0
ISTEM=0
IF(IABS(J4).LT.80)GO TO 100
R4=AMOD(R4,100.)
RMINI=RMINI*.7
100 IF(J5.GT.9)GO TO 10
GO TO(1,1,1,4,5,26,7,5,9)J5
10 IF(J5.GT.19)GO TO 200
GO TO(11,11,11,11,11,11,17,17)J5-10
200 IF(J5.GT.29)GO TO 30
GO TO(20,20,20,20,5,25,26)J5-19
C**** FICTA
1 JACC=J5
RLVL=R4
CALL ACCI
RETURN
C**** WEDGE
4 JX=5
RX=R3+.5*RSTJ2
C SHIFT A LITTLE TO RIGHT
41 RA=RMINI
RB=RA
IF(RINV.LT.0)RA=-RA
40 CALL MRKZ(JX,CENTR)
RETURN
C**** ACCENT
5 JX=1
RX=R3
GO TO 41
C**** STACCATO
7 RX=R3+6.7*RMINI
C PUSH DOT TO RIGHT
RG=9.
IF(IPLT.LT.0)RG=17.
C DOESN'T FILL DOT ON DPY
RB=14.
77 CALL RDRAW(1,RG,RDOT,RMINI,RX,CENTR+RSTJ2,RMINI)
RETURN
C**** TENUTO (DASH) (STARTS ABOVE)
9 CALL TENUTO(CENTR)
RETURN
C*** UPBOW, ETC.
11 JX=NXAC(J5-10)
RA=RMINI
RB=RA
RX=R3
GO TO 40
C*** 17=MORDENT 18=INVERTED MORDENT
17 RINV=J5
GO TO 26
C*** TRILL
20 JA=7
R5=0
J7=1
R7=1.
R8=J5-20
C R8 HAS THE ACCIDENTAL TO PUT OVER TR.
CALL ALPHA
RETURN
C*** HEAVY WEDGE
25 R7=0
ISTEM=2
IF(RINV.LT.0)ISTEM=1
RX4=R4
C*** FERMATA
26 CALL FERMTA
RETURN
C*** FINGERING
30 R5=J5-30
C GET THE 1 DIGIT NUM.
C PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
RX=8.
C 8. SETS POS. AS IF NUM.WERE UNDER NOTE WITH STEM UP.
J3=R3+RX*RMINI
R6=.7
R7=0
R8=0
R9=0
R4=R4+2.5
CALL MAKNUM(R5)
C ADD HERE FOR NUMS WITH ACCENTS, ETC.
END